﻿module SVMInstructions

open SVMTypes
open SVMBinaryLib

let rec set (l : 'a list) (elem : 'a) (n : int) : 'a list =
  match l with
  | [] -> failwith "Index out of bound"
  | x :: xs when n = 0 -> elem :: xs
  | x :: xs -> x :: (set xs elem (n - 1))

let convert_address (arg : string) : string =
  if (arg.StartsWith "[" && arg.EndsWith "]") then
    let arg_no_head = arg.Remove(0,1)
    let arg_no_tail = arg_no_head.Remove(arg_no_head.Length - 1)
    arg_no_tail
  else
    arg

let is_register (arg : string) : bool =
  match arg with
  | "reg1" | "reg2" | "reg3" | "reg4" -> true
  |_ -> false

let get_type (arg : string) : OpType =
  match arg with
  | "reg1" | "reg2" | "reg3" | "reg4" -> Register
  | _ when arg.StartsWith "[" && arg.EndsWith "]" -> Memory
  | _ -> Constant

let register_index (arg : string) : int =
  match arg with
  | "reg1" -> 0
  | "reg2" -> 1
  | "reg3" -> 2
  | "reg4" -> 3
  | _ -> failwith "Invalid register name"

let get_arg_val (svm : SVM) (arg : string) : Option<int64> * string =
  match get_type arg with
  | Register -> Some(List.nth svm.Registers (register_index arg)),""
  | Memory ->
      let address = convert_address arg
      if int address > 99 then
        None,"Address out of bound"
      else
        Some (List.nth svm.Memory (int address)),""
  | Constant -> Some (decimal_to_binary (int arg)),""

let set_arg_val (svm : SVM) (arg : string) (v : int64) : Option<SVM> * string =
  match get_type arg with
  | Register ->
      let new_state =
        {
          Registers = set svm.Registers v (register_index arg)
          Memory = svm.Memory
          InstructionSet = svm.InstructionSet 
        }
      Some new_state,""
  | Memory ->
      let address = convert_address arg
      if int address > 99 then
        None,"Address out of bound"
      else
        let new_state =
          {
            Registers = svm.Registers
            Memory = set svm.Memory v (int address)
            InstructionSet = svm.InstructionSet
          }
        Some new_state,""
  | _ -> failwith "unsupported assign operand"


//MACHINE INSTRUCTION FUNCTIONS

let nop (current_state : SVM) : Option<SVM> * string =
  Some current_state,""

let load (current_state : SVM) (arg1 : string) (arg2 : string) : Option<SVM> * string  =
  let arg2_val,error = get_arg_val current_state arg2
  match arg2_val with
  | None -> None,error
  | Some value -> 
      let new_state = set_arg_val current_state arg1 value
      new_state

let store (current_state : SVM) (arg1 : string) (arg2 : string) : Option<SVM> * string  =
  let arg2_val,error = get_arg_val current_state arg2
  match arg2_val with
  | None -> None,error
  | Some value ->
      if value > max_val then
        None,"Arg2 overflow error"
      else
         let new_state = set_arg_val current_state arg1 value
         new_state

let and_op (current_state : SVM) (arg1 : string) (arg2 : string) : Option<SVM> * string =
  let arg1_val,error = get_arg_val current_state arg1
  let arg2_val,error = get_arg_val current_state arg2
  match arg1_val,arg2_val with
  | Some value1,Some value2 ->
      if value2 > max_val then
        None,"Arg2 overflow error"
      else
        let val1_list = int_to_list value1 |> fill_digits
        let val2_list = int_to_list value2 |> fill_digits

        let rec bit_and (bin1 : int list) (bin2 : int list) =
          match bin1,bin2 with
          | [],[] -> []
          | x :: xs, y :: ys ->
              if x = 1 && y = 1 then
                1 :: (bit_and xs ys)
              else
                0 :: (bit_and xs ys)
          | _ -> failwith "BUG in and_op, different length for lists, possible error in fill_digits"

        let op_res = bit_and (val1_list |> List.rev) (val2_list |> List.rev)
        let op_res_val = list_to_int op_res 10
        let new_state = set_arg_val current_state arg1 op_res_val
        new_state
  | _ -> None,error
